home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
An Invitation to the Roland World of Music
/
Roland - An Invitation To The Roland World Of Music.bin
/
vb
/
vb30
/
disk1
/
blanker.fr_
/
blanker.bin
Wrap
Text File
|
1993-04-27
|
23KB
|
720 lines
VERSION 2.00
Begin Form DemoForm
BackColor = &H00000000&
Caption = "Screen Blanker Demo"
ClientHeight = 4425
ClientLeft = 960
ClientTop = 1965
ClientWidth = 7470
ForeColor = &H00000000&
Height = 5115
Icon = BLANKER.FRX:0000
Left = 900
LinkMode = 1 'Source
LinkTopic = "Form1"
Picture = BLANKER.FRX:0302
ScaleHeight = 4425
ScaleWidth = 7470
Top = 1335
Width = 7590
Begin Timer Timer1
Interval = 1
Left = 6960
Top = 120
End
Begin CommandButton cmdStartStop
BackColor = &H00000000&
Caption = "Start Demo"
Default = -1 'True
Height = 390
Left = 240
TabIndex = 0
Top = 120
Width = 1830
End
Begin PictureBox picBall
AutoSize = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
ForeColor = &H00FFFFFF&
Height = 600
Left = 1800
Picture = BLANKER.FRX:0740
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 1
Top = 720
Visible = 0 'False
Width = 600
End
Begin Image imgMoon
Height = 480
Index = 8
Left = 6330
Picture = BLANKER.FRX:0A42
Top = 3765
Visible = 0 'False
Width = 480
End
Begin Line linLineCtl
BorderColor = &H00FF0000&
BorderWidth = 5
Visible = 0 'False
X1 = 240
X2 = 4080
Y1 = 2760
Y2 = 2760
End
Begin Image imgMoon
Height = 480
Index = 7
Left = 5760
Picture = BLANKER.FRX:0D44
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 6
Left = 5160
Picture = BLANKER.FRX:1046
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 5
Left = 4560
Picture = BLANKER.FRX:1348
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 4
Left = 3960
Picture = BLANKER.FRX:164A
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 3
Left = 3360
Picture = BLANKER.FRX:194C
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 2
Left = 2760
Picture = BLANKER.FRX:1C4E
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 1
Left = 2160
Picture = BLANKER.FRX:1F50
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Image imgMoon
Height = 480
Index = 0
Left = 1560
Picture = BLANKER.FRX:2252
Top = 3720
Visible = 0 'False
Width = 480
End
Begin Shape shpClone
BackColor = &H00000000&
BackStyle = 1 'Opaque
BorderColor = &H00FF0000&
FillColor = &H000000FF&
Height = 1215
Index = 0
Left = 240
Top = 720
Visible = 0 'False
Width = 1410
End
Begin Shape Shape1
Height = 15
Left = 960
Top = 1080
Width = 15
End
Begin Menu mnuOption
Caption = "&Options"
Begin Menu mnuLineCtlDemo
Caption = "&Jumpy Line"
Checked = -1 'True
End
Begin Menu mnuCtlMoveDemo
Caption = "Re&bound"
End
Begin Menu mnuImageDemo
Caption = "&Spinning Moon"
End
Begin Menu mnuShapeDemo
Caption = "&Madhouse"
End
Begin Menu mnuPSetDemo
Caption = "&Confetti"
End
Begin Menu mnuLineDemo
Caption = "C&rossfire"
End
Begin Menu mnuCircleDemo
Caption = "Rainbo&w Rug"
End
Begin Menu mnuScaleDemo
Caption = "Co&lor Bars"
End
Begin Menu sep1
Caption = "-"
End
Begin Menu mnuExit
Caption = "E&xit"
End
End
End
Option Explicit
' Declare variable to track animation frame
Dim Shared FrameNum
' Declare the X and Y-coordinate variables to track position.
Dim Shared XPos
Dim Shared YPos
' Declare variable flag to stop graphic routines in Do Loops
Dim Shared DoFlag
' Declare variable to track moving controls
Dim Shared Motion
' Declare form variables for color.
Dim R
Dim G
Dim B
Sub CircleDemo ()
' Declare local variables
Dim Radius
' Create random RGB colors
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' Position center of circles in form center
XPos = ScaleWidth / 2
YPos = ScaleHeight / 2
' Generate radius between 0 and almost half form height
Radius = ((YPos * .9) + 1) * Rnd
' Draw circle on form
Circle (XPos, YPos), Radius, RGB(R, G, B)
End Sub
Sub cmdStartStop_Click ()
' Declare local variables.
Dim UnClone
Dim MakeClone
Dim X1
Dim Y1
Select Case DoFlag
Case True
cmdStartStop.Caption = "Start Demo"
DoFlag = False
mnuOption.Enabled = True
If mnuCtlMoveDemo.Checked = True Then
' Hide bouncing graphic again.
picBall.Visible = False
ElseIf mnuLineDemo.Checked = True Then
' Remove lines from the form.
Cls
ElseIf mnuShapeDemo.Checked = True Then
' Remove all dynamically loaded Shape controls.
For UnClone = 1 To 20
Unload shpClone(UnClone)
Next UnClone
' Reset background color of form to black.
DemoForm.BackColor = QBColor(0)
' Refresh form so color change takes effect.
Refresh
ElseIf mnuPSetDemo.Checked = True Then
' Remove confetti bits from form.
Cls
ElseIf mnuLineCtlDemo.Checked = True Then
' Hide Line control again.
linLineCtl.Visible = False
' Remove any stray pixels left after hiding line.
Cls
ElseIf mnuImageDemo.Checked = True Then
' Hide bouncing graphic again.
imgMoon(0).Visible = False
ElseIf mnuScaleDemo.Checked = True Then
' Clear form.
Cls
' Return form to the default scale.
Scale
ElseIf mnuCircleDemo.Checked = True Then
' Remove the circles from form.
Cls
End If
Case False
cmdStartStop.Caption = "Stop Demo"
DoFlag = True
mnuOption.Enabled = False
If mnuCtlMoveDemo.Checked = True Then
' Make the bouncing graphic (Picture box control) visible.
picBall.Visible = True
' Determine initial motion of bouncing graphic at random.
' Settings are 1 to 4. Value of variable Motion determines
' what part of the Do Loop routine runs.
Motion = Int(4 * Rnd + 1)
ElseIf mnuLineDemo.Checked = True Then
' Initialize random-number generator.
Randomize
' Set line width
DrawWidth = 2
' Set initial X and Y-coordinates to a random spot on form
X1 = Int(DemoForm.Width * Rnd + 1)
Y1 = Int(DemoForm.Height * Rnd + 1)
ElseIf mnuShapeDemo.Checked = True Then
' Dynamically load a control array of 20 Shape controls on the form.
For MakeClone = 1 To 20
Load shpClone(MakeClone)
Next MakeClone
ElseIf mnuPSetDemo.Checked = True Then
' Set thickness of confetti bits.
DrawWidth = 5
ElseIf mnuLineCtlDemo.Checked = True Then
' Make Line control visible.
linLineCtl.Visible = True
' Set thickness of line as it will appear.
DrawWidth = 7
ElseIf mnuImageDemo.Checked = True Then
' Make bouncing graphic (Image control) visible.
imgMoon(0).Visible = True
' Set initial animation frame
FrameNum = 0
' Determine initial motion of bouncing graphic at random.
' Settings are 1 to 4. Value of variable Motion determines
' what part of the Do Loop routine runs.
Motion = Int(4 * Rnd + 1)
ElseIf mnuScaleDemo.Checked = True Then
' Initialize random-number generator.
Randomize
' Set width of box outlines so boxes don't overlap.
DrawWidth = 1
' Set value of X-coordinate of left edge of form. Then the 1st to 1 to easily
' box has X-coordinate = 1, 2nd box = 2, etc.
ScaleLeft = 1
' Set Y-coordinate of top edge of form to 10.
ScaleTop = 10
' Set # of units in form width to a random number between
' 3 and 12. This changes # of boxes drawn each time the
' routine starts
ScaleWidth = Int(13 * Rnd + 3)
' Set # of units in form height -10. Then height of all boxes
' varies from 0 to 10 and Y-coordinates start at form bottom
ScaleHeight = -10
ElseIf mnuCircleDemo.Checked = True Then
' Define width of circle outline.
DrawWidth = 1
' Draw circles as dashed lines.
DrawStyle = 1
' Draw lines using the XOR pen, combining colors found in the pen and
' in the display but not in both.
DrawMode = 7
End If
End Select
End Sub
Sub CtlMoveDemo ()
Select Case Motion
Case 1
' Move graphic left/up by 20 twips using Move method
picBall.Move picBall.Left - 20, picBall.Top - 20
' If graphic reaches left edge of form, move it right/up
If picBall.Left <= 0 Then
Motion = 2
' If graphic reaches top edge of form, move it left/down
ElseIf picBall.Top <= 0 Then
Motion = 4
End If
Case 2
' Move graphic right/up by 20 twips
picBall.Move picBall.Left + 20, picBall.Top - 20
' If the graphic reaches right edge of form, move left/up.
' Routine determines right edge of form by subtracting graphic
' width from form width
If picBall.Left >= (DemoForm.Width - picBall.Width) Then
Motion = 1
' If graphic reaches top edge of form, move right/down
ElseIf picBall.Top <= 0 Then
Motion = 3
End If
Case 3
' Move graphic right/down by 20 twips
picBall.Move picBall.Left + 20, picBall.Top + 20
' If graphic reaches right edge of form, move left/down
If picBall.Left >= (DemoForm.Width - picBall.Width) Then
Motion = 4
' If graphic reaches bottom edge of form, move right/up.
' Routine determines bottom of form by subtracting
' graphic height from form height less 680 twips for height
' of title bar and menu bar
ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
Motion = 2
End If
Case 4
' Move the graphic left/down by 20 twips
picBall.Move picBall.Left - 20, picBall.Top + 20
' If graphic reaches left edge of form, move right/down
If picBall.Left <= 0 Then
Motion = 3
' If graphic reaches bottom edge of the form, move left/up
ElseIf picBall.Top >= (DemoForm.Height - picBall.Height) - 680 Then
Motion = 1
End If
End Select
End Sub
Sub Delay ()
Dim Start
Dim Check
Start = Timer
Do Until Check >= Start + .15
Check = Timer
Loop
End Sub
Sub Form_Load ()
DoFlag = False
End Sub
Sub Form_Resize ()
If mnuScaleDemo.Checked = True Then
' Initialize the random-number generator.
Randomize
' Set the width of the box outlines to narrow so the boxes don't overlap.
DrawWidth = 1
' Set the value of the X-coordinate of the left edge of the form to 1.
' This makes it easy to set the position for each box. The first box has
' an X-coordinate of 1, the second has an X-coordinate of 2, etc.
ScaleLeft = 1
' Set the value of the Y-coordinate of the top edge of the form to 10.
ScaleTop = 10
' Set the number of units in the width of the form to a random number between
' 3 and 12. This changes the number of boxes that are drawn each time the user
' starts this routine.
ScaleWidth = Int(13 * Rnd + 3)
' Set the number of units in the height of the form to negative 10. This has
' two effects. First, all the boxes then have a height that varies from 0 to 10.
' Second, the negative value causes the Y-coordinates to begin at the bottom
' edge of the form instead of at the top.
ScaleHeight = -10
End If
End Sub
Sub Form_Unload (Cancel As Integer)
End
End Sub
Sub ImageDemo ()
Select Case Motion
Case 1
' Move graphic left/up by 100 twips using Move method
imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top - 100
' Increment animation to next frame
IncrFrame
' If graphic reaches left edge of form, move right/up
If imgMoon(0).Left <= 0 Then
Motion = 2
' If graphic reaches top edge of the form, move left/down
ElseIf imgMoon(0).Top <= 0 Then
Motion = 4
End If
Case 2
' Move graphic right/up by 100 twips
imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top - 100
' Increment animation to next frame
IncrFrame
' If graphic reaches right edge of form, move left/up.
' Routine determines the right edge of form by subtracting
' graphic width from control width
If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
Motion = 1
' If graphic reaches top edge of the form, move right/down
ElseIf imgMoon(0).Top <= 0 Then
Motion = 3
End If
Case 3
' Move graphic right/down by 100 twips
imgMoon(0).Move imgMoon(0).Left + 100, imgMoon(0).Top + 100
' Increment animation to next frame
IncrFrame
' If graphic reaches right edge of form, move left/down
If imgMoon(0).Left >= (DemoForm.Width - imgMoon(0).Width) Then
Motion = 4
' If graphic reaches bottom edge of form, move right/up.
' Routine determines bottom edge of form by subtracting graphic
' height from form height minus 680 twips for height of title
' bar and menu bar
ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
Motion = 2
End If
Case 4
' Move graphic left/down by 100 twips
imgMoon(0).Move imgMoon(0).Left - 100, imgMoon(0).Top + 100
' Increment animation to next frame
IncrFrame
' If graphic reaches left edge of form, move right/down
If imgMoon(0).Left <= 0 Then
Motion = 3
' If graphic reaches bottom edge of form, move left/up
ElseIf imgMoon(0).Top >= (DemoForm.Height - imgMoon(0).Height) - 680 Then
Motion = 1
End If
End Select
End Sub
Sub IncrFrame ()
' Increment frame #
FrameNum = FrameNum + 1
' Control array with animation frames has elements 0 to 7. At the 8th
' frame, reset the frame # to 0 for endless animation loop
If FrameNum > 8 Then
FrameNum = 1
End If
' Set Picture property of image control to Picture property of current
' frame
imgMoon(0).Picture = imgMoon(FrameNum).Picture
' Pause display so animation isn't too fast
Delay
End Sub
Sub LineCtlDemo ()
' Set X and Y-coordinates (left/right position) of line's start to
' random spot on form
linLineCtl.X1 = Int(DemoForm.Width * Rnd)
linLineCtl.Y1 = Int(DemoForm.Height * Rnd)
' Set X and Y-coordinates (left/right position) of line's end to
' random spot on form
linLineCtl.X2 = Int(DemoForm.Width * Rnd)
linLineCtl.Y2 = Int(DemoForm.Height * Rnd)
' Clear form to remove any stray pixels
Cls
' Pause display before moving line again
Delay
End Sub
Sub LineDemo ()
' Declare local variables
Dim X2
Dim Y2
' Create random RGB colors
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' Set end point of line to random spot on form
X2 = Int(DemoForm.Width * Rnd + 1)
Y2 = Int(DemoForm.Height * Rnd + 1)
' Using Line method, draw from current coordinates to current end
' point, giving line a random color. Each line starts where last
' line ends.
Line -(X2, Y2), RGB(R, G, B)
End Sub
Sub mnuCircleDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = True
End Sub
Sub mnuCtlMoveDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = True
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub mnuExit_Click ()
End
End Sub
Sub mnuImageDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = True
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub mnuLineCtlDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = True
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub mnuLineDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = True
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub mnuPSetDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = True
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub mnuScaleDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = False
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = True
mnuCircleDemo.Checked = False
End Sub
Sub mnuShapeDemo_Click ()
Cls
mnuCtlMoveDemo.Checked = False
mnuLineDemo.Checked = False
mnuShapeDemo.Checked = True
mnuPSetDemo.Checked = False
mnuLineCtlDemo.Checked = False
mnuImageDemo.Checked = False
mnuScaleDemo.Checked = False
mnuCircleDemo.Checked = False
End Sub
Sub PSetDemo ()
' Create random RGB colors
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' Xpos sets horiz position of confetti bit to random spot on form
XPos = Rnd * ScaleWidth
' YPos sets vertical position of confetti bit to random spot on form
YPos = Rnd * ScaleHeight
' Draw confetti bit at XPos, Ypos. Assign confetti bit a random color
PSet (XPos, YPos), RGB(R, G, B)
End Sub
Sub ScaleDemo ()
' Declare local variables
Dim Box
' Creates same number of boxes as units in the width of form
For Box = 1 To ScaleWidth
' Create random RGB colors
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' Draw boxes using te Line method with B (box) F (filled) options.
' Boxes start at each X-coordinate determined by ScaleWidth and at
' a Y-coordinate of 0 (bottom of form). Each box is 1 unit wide and
' has a random height between 0 and 10. Fill box with random color.
Line (Box, 0)-Step(1, (Int(11 * Rnd))), RGB(R, G, B), BF
Next Box
' Pause to display all boxes before redraw
Delay
End Sub
Sub ShapeDemo ()
' Declare local variables
Dim CloneID
' Create random RGB colors
R = 255 * Rnd
G = 255 * Rnd
B = 255 * Rnd
' Set form background color to random value
DemoForm.BackColor = RGB(R, G, B)
' Select random Shape control in control array
CloneID = Int(20 * Rnd + 1)
' XPos and Ypos set position of selected Shape control to random
' spot on the form.
XPos = Int(DemoForm.Width * Rnd + 1)
YPos = Int(DemoForm.Height * Rnd + 1)
' Set the shape of the selected Shape control to a random shape.
shpClone(CloneID).Shape = Int(6 * Rnd)
' Set height/width of selected Shape control to random size between
' 500 and 2500 twips
shpClone(CloneID).Height = Int(2501 * Rnd + 500)
shpClone(CloneID).Width = Int(2501 * Rnd + 500)
' Set background color and DrawMode of Shape control to random color
shpClone(CloneID).BackColor = QBColor(Int(15 * Rnd))
shpClone(CloneID).DrawMode = Int(16 * Rnd + 1)
' Move selected Shape control using Move method to XPos, YPos
shpClone(CloneID).Move XPos, YPos
' Make the selected Shape control visible.
shpClone(CloneID).Visible = True
' Wait briefly before selecting and changing the next Shape control.
Delay
End Sub
Sub Timer1_Timer ()
If mnuCtlMoveDemo.Checked And DoFlag = True Then
CtlMoveDemo
ElseIf mnuLineDemo.Checked And DoFlag = True Then
LineDemo
ElseIf mnuShapeDemo.Checked And DoFlag = True Then
ShapeDemo
ElseIf mnuPSetDemo.Checked And DoFlag = True Then
PSetDemo
ElseIf mnuLineCtlDemo.Checked And DoFlag = True Then
LineCtlDemo
ElseIf mnuImageDemo.Checked And DoFlag = True Then
ImageDemo
ElseIf mnuScaleDemo.Checked And DoFlag = True Then
ScaleDemo
ElseIf mnuCircleDemo.Checked And DoFlag = True Then
CircleDemo
End If
End Sub